home *** CD-ROM | disk | FTP | other *** search
/ Business Shareware / Business Shareware.iso / start / database / lib194 / fields.prg < prev    next >
Encoding:
Text File  |  1993-01-28  |  22.3 KB  |  609 lines

  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FIELDS.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: These field processing routines were deemed as not as commonly
  6. *--             used (at least in my own Applications), and relegated to a 
  7. *--             library file. See: README.TXT about how to use this library
  8. *--             file.
  9. *-------------------------------------------------------------------------------
  10.  
  11. FUNCTION MemoPagr
  12. *-------------------------------------------------------------------------------
  13. *-- Programmer..: Martin Leon (HMAN - ATBBS/Borland BBS)
  14. *-- Date........: 10/28/91
  15. *-- Notes.......: Used to display a memo on screen, allowing user to scroll
  16. *--               memo at will.
  17. *-- Written for.: dBASE IV, 1.1
  18. *-- Rev. History: None
  19. *-- Calls.......: None
  20. *-- Called by...: Any
  21. *-- Usage.......: ?MemoPagr(<cMemo>,<ULRow>,<ULCol>,<BRRow>,<BRCol>)
  22. *-- Example.....: ?MemoPagr(MoreData,10,20,20,65)
  23. *-- Returns.....: .F.
  24. *-- Parameters..: cMemo   = name of memo field
  25. *--               nULRow  = upper left row position
  26. *--               nULCol  = upper left column position
  27. *--               nBRRow  = bottom right row position
  28. *--               nBRCol  = bottom right column position
  29. *-------------------------------------------------------------------------------
  30.     
  31.     PARAMETER cMemo, nULRow, nULCol, nBRRow, nBRCol
  32.     private cCursor, nEsc, nPgDn, nPgUp, nUp, nDn, nNumLines,nLines,nKey
  33.     private nAtLine,nAtRow
  34.     
  35.     *-- set environment
  36.     set memowidth to nBRCol - nULCol - 1
  37.     cCursor = set( "CURSOR" )
  38.     set cursor off
  39.     
  40.     *-- define a few keys
  41.     nEsc  = 27
  42.     nPgDn = 3
  43.     nPgUp = 18
  44.     nUp   = 5
  45.     nDn   = 24
  46.     
  47.     *-- determine size of window
  48.     nNumLines = memlines(&cMemo)
  49.     nLines = nBRRow - nULRow - 1
  50.     *-- save the screen, so we can restore it
  51.     save screen to sTmp
  52.     @ nULRow+1, nULCol+1 clear to nBRRow+1, nBRCol+1
  53.     @ nULRow+1, nULCol+1 fill to nBRRow+1, nBRCol+1 color B/N
  54.     @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 color RG+/B
  55.     @ nULRow, nULCol to nBRRow, nBRCol double color RG+/B
  56.     
  57.     *-- deal with a blank memo ...
  58.     if nNumLines = 0
  59.        @ nULRow + 1, nULCol + 1 SAY ;
  60.           "Blank Memo.  Press any key to continue..." color RG+/B
  61.        nKey = inkey(0)
  62.         *-- reset the whole thing
  63.        restore screen from sTmp
  64.        release screen sTmp
  65.        set cursor &cCursor
  66.        RETURN .F.
  67.     endif
  68.     
  69.     nAtLine = 1
  70.     nAtRow = 1
  71.     do while nAtLine <= nNumLines
  72.        *-- Show one window full
  73.        do while nAtRow <= nLines .and. nAtLine <= nNumLines
  74.           @ nULRow+nAtRow, nULCol + 1 say ;
  75.              mline( &cMemo, nAtLine ) color RG+/B
  76.           nAtLine = nAtLine + 1
  77.           nAtRow = nAtRow + 1
  78.        enddo
  79.    
  80.        *-- If at last line of memo...
  81.        if nAtLine > nNumLines
  82.           *-- If memo is shorter than one page, put box character in
  83.           *-- bottom left corner of box, otherwise, put an up arrow
  84.           *-- symbol there.
  85.           @ nBRRow - 1, nBRCol SAY ;
  86.          iif( nNumLines <= nLines, chr(186), chr(24)) color W+/B
  87.           do while .T.
  88.              nKey = inkey(0)
  89.              *-- If memo is shorter than one page, only allow Esc key
  90.              if nNumLines <= nLines
  91.                 if nKey = nEsc
  92.                    exit
  93.                 endif
  94.              *-- Otherwise, allow Esc or PgUp keys
  95.              else
  96.                 if nKey = nEsc .or. nKey = nPgUp .or. nKey = nUp
  97.                    exit
  98.                 endif
  99.              endif
  100.              ?? chr(7)
  101.           enddo
  102.           if nKey = nEsc
  103.              restore screen from sTmp
  104.              release screen sTmp
  105.              set cursor &cCursor
  106.              RETURN .F.
  107.           endif
  108.           @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  109.           @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  110.              color RG+/B
  111.           nAtLine = nAtLine -  nAtRow - nLines + 1
  112.           nAtLine = iif( nAtLine < 1, 1, nAtLine )
  113.           nAtRow = 1
  114.           loop
  115.        endif
  116.    
  117.        *-- Not at end of memo yet...
  118.        *-- If on first page, show down arrow only, otherwise show
  119.        *-- up/down arrow on border of box.
  120.        @ nBRRow - 1, nBRCol say ;
  121.            iif( nAtLine - nLines = 1, chr(25), chr(18)) color W+/B
  122.        do while .T.
  123.           nKey = inkey(0)
  124.           *-- If this is the first page of the memo on screen...
  125.           if nAtLine - nLines = 1
  126.               *-- Only honor PgDn, up cursor, and Esc keys
  127.              if nKey = nPgDn .or. nKey = nDn .or. nKey = nEsc
  128.                 exit
  129.              endif
  130.           *-- otherwise honor PgUp and up cursor as well key as well
  131.           else 
  132.              if nKey = nPgUp .or. nKey = nUp .or. nKey = nPgDn .or. ;
  133.                     nKey = nDn .or. nKey = nEsc
  134.                 exit
  135.              endif
  136.           endif
  137.           ?? chr(7)
  138.        enddo
  139.        do case
  140.           case nKey = nEsc
  141.              restore screen from sTmp
  142.              release screen sTmp
  143.              set cursor &cCursor
  144.              RETURN .F.
  145.           case nKey = nPgUp .or. nKey = nUp
  146.              @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  147.              @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  148.                 color RG+/B
  149.              nAtLine = (nAtLine - (2 * nLines))
  150.              nAtLine = IIF( nAtLine < 1, 1, nAtLine )
  151.              nAtRow = 1
  152.              loop
  153.           case nKey = nPgDn .or. nKey = nDn
  154.              @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  155.              @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  156.                 color RG+/B
  157.              nAtRow = 1
  158.              loop
  159.        endcase
  160.     enddo
  161.  
  162. RETURN .F.
  163. *-- EoF: MemoPagr()
  164.  
  165. PROCEDURE ScanMemo
  166. *-------------------------------------------------------------------------------
  167. *-- Programmer..: Martin Leon (HMAN)
  168. *-- Date........: 02/27/1992
  169. *-- Notes.......: This simple procedure is used to strip hard carriage returns
  170. *--               out of all Memos in a database.
  171. *-- Written for.: dBASE IV, 1.1
  172. *-- Rev. History: 04/15/1991 - original procedure.
  173. *--               02/07/1992 -- Douglas P. Saine (XRED) modified to handle
  174. *--                passing of database name as a parameter
  175. *-- Calls.......: None
  176. *-- Called by...: Any
  177. *-- Usage.......: Do ScanMemo with "<cDbf>"
  178. *-- Example.....: Do ScanMemo with "TEST"
  179. *-- Returns.....: None.
  180. *-- Parameters..: cDbf = Name of the database to scan memos ...
  181. *-------------------------------------------------------------------------------
  182.  
  183.     parameter cDbf
  184.     private nFields, cFieldName, nLines, nLineNum
  185.     
  186.     use (cDbf)
  187.     
  188.     scan   && search database 1 record at a time ...
  189.         nFields = 1
  190.         *-- This loop goes through all fields in the database
  191.         do while asc(field(nFields)) # 0
  192.             cFieldName = field(nFields)     && save current field name
  193.             if type(cFieldName) = "M"       && check to see if it's a memo
  194.                 nLines = memlines(&cFieldName)  && number of lines in memo
  195.                 if nLines > 1                   && if there's something there
  196.                     delete file temp.txt         && kill old file if it exists
  197.                     set printer to file temp.txt && copy memo a line at a time to
  198.                     nLineNum = 1                 && temp file, using ??? command.
  199.                     do while nLineNum <= nLines
  200.                         ??? mline(&cFieldName,nLineNum)
  201.                         ??? " "
  202.                         nLineNum = nLineNum + 1
  203.                     enddo
  204.                     close printer
  205.                     set printer to
  206.                     append memo &cFieldName from temp.txt overwrite
  207.                 endif  && nLines > 1
  208.             endif  && type(cFieldName) = "M"
  209.             nFields = nFields + 1  && go to next field ...
  210.         enddo  && asc(field....
  211.     endscan  && scan of database record by record ...
  212.     
  213.     use  && close database
  214.  
  215. RETURN
  216. *-- EoP: ScanMemo
  217.  
  218. PROCEDURE Cut
  219. *-------------------------------------------------------------------------------
  220. *-- Programmer..: Michael B. Carlisle (Borland)
  221. *-- Date........: 01/xx/1992 
  222. *-- Notes.......: This retrieves information from the field the user has
  223. *--               currently selected and stores the information into a 
  224. *--               memory variable titled CLIPBOARD. The field itself is
  225. *--               then cleared. CLIPBOARD should be declared public. 
  226. *--               This routine is taken from TECHNOTES.
  227. *-- Written for.: dBASE IV, 1.1
  228. *-- Rev. History: None
  229. *-- Calls.......: None
  230. *-- Called by...: Any
  231. *-- Usage.......: do CUT with "<cFld>","<cScrType>"
  232. *-- Example.....: on key label F6 do CUT with varread(),"READ"
  233. *-- Returns.....: None
  234. *-- Parameters..: cFld     = Field to 'CUT' the data from.
  235. *--               cScrType = What screen type? Valid options are BROWSE,
  236. *--                           EDIT and READ.
  237. *-------------------------------------------------------------------------------
  238.  
  239.     parameters cFld,cScrType
  240.     
  241.     *-- test field type, ignore if field is memo
  242.     clipboard = iif(type(cFld) = "D",;
  243.                     right(dtos(&cFld),4)+substr(dtos(&cFld),3,2),;
  244.                  iif(type(cFld) = "L",iif(&cFld,"T","F"),;
  245.                  iif(type(cFld)="M","",&cFld)))
  246.         
  247.     *-- if field type is Numeric or Float, convert to string.
  248.     if type(cFld) $ "NF"
  249.         clipboard = ltrim(str(int(fixed(&cFld)),20)+;
  250.                      right(str(fixed(&cFld) - int(fixed(&cFld)),20,18,19))
  251.         do while val(right(clipboard,1)) = 0 .and. .not. right(clipboard,1)="."
  252.             clipboard = left(clipboard,len(clipboard)-1)
  253.         enddo
  254.     endif
  255.     
  256.     *-- Ring bell if field is MEMO, otherwise, clear the field
  257.     if type(cFld) = "M"
  258.         ?? chr(7)
  259.     else
  260.         *-- do to difference in function of the HOME keys in BROWSE mode,
  261.         *-- Ctrl-Home has to be used in BROWSE
  262.         if upper(cScrType) = "BROWS"
  263.             keyboard chr(29)+chr(25)  && go to beginning of field and clear
  264.         else
  265.             keyboard chr(26)+chr(25)  && ditto
  266.         endif
  267.     endif
  268.  
  269. RETURN
  270. *-- EoP: Cut
  271.  
  272. PROCEDURE Copy
  273. *-------------------------------------------------------------------------------
  274. *-- Programmer..: Michael B. Carlisle (Borland)
  275. *-- Date........: 01/xx/1992
  276. *-- Notes.......: This retrieves information from the field the user has
  277. *--               currently selected and stores the information into a 
  278. *--               memory variable titled CLIPBOARD. The field itself is
  279. *--               left 'as is' (unlike CUT). CLIPBOARD should be declared 
  280. *--               public. This routine is taken from TECHNOTES.
  281. *-- Written for.: dBASE IV, 1.1
  282. *-- Rev. History: None
  283. *-- Calls.......: None
  284. *-- Called by...: Any
  285. *-- Usage.......: do COPY with "<cFld>"
  286. *-- Example.....: on key label F8 do COPY with varread()
  287. *-- Returns.....: None
  288. *-- Parameters..: cFld     = Field to 'COPY' the data from.
  289. *-------------------------------------------------------------------------------
  290.  
  291.     parameters cFld
  292.     
  293.     *-- test field type, ignore if field is memo
  294.     clipboard = iif(type(cFld) = "D",;
  295.                     right(dtos(&cFld),4)+substr(dtos(&cFld),3,2),;
  296.                  iif(type(cFld) = "L",iif(&cFld,"T","F"),;
  297.                  iif(type(cFld)="M","",&cFld)))
  298.         
  299.     *-- if field type is Numeric or Float, convert to string.
  300.     if type(cFld) $ "NF"
  301.         clipboard = ltrim(str(int(fixed(&cFld)),20)+;
  302.                      right(str(fixed(&cFld) - int(fixed(&cFld)),20,18,19))
  303.         do while val(right(clipboard,1)) = 0 .and. .not. right(clipboard,1)="."
  304.             clipboard = left(clipboard,len(clipboard)-1)
  305.         enddo
  306.     endif
  307.     
  308.     *-- Ring bell if field is MEMO, otherwise, clear the field
  309.     if type(cFld) = "M"
  310.         ?? chr(7)
  311.     endif
  312.     
  313. RETURN
  314. *-- EoP: Copy
  315.  
  316. PROCEDURE Paste
  317. *-------------------------------------------------------------------------------
  318. *-- Programmer..: Michael B. Carlisle (Borland)
  319. *-- Date........: 01/xx/1992
  320. *-- Notes.......: Paste writes out the contents of the CLIPBOARD (public)
  321. *--               memvar to the currently selected field. Because all values
  322. *--               are converted to strings when stored into the CLIPBOARD,
  323. *--               Paste is able to write values from one field type to another
  324. *--               (such as numeric to character, date to numeric, etc.).
  325. *--               This routine is taken from TECHNOTES.
  326. *-- Written for.: dBASE IV, 1.1
  327. *-- Rev. History: None
  328. *-- Calls.......: None
  329. *-- Called by...: Any
  330. *-- Usage.......: do PASTE with "<cFld>","<cScrType>"
  331. *-- Example.....: on key label F7 do PASTE with varread(), "READ"
  332. *-- Returns.....: None
  333. *-- Parameters..: cFld     = Field to 'PASTE' the data in CLIPBOARD to.
  334. *--               cScrType = What screen type? Valid options are BROWSE,
  335. *--                           EDIT and READ.
  336. *-------------------------------------------------------------------------------
  337.     
  338.     parameters cFld, cScrType
  339.  
  340.     *-- ring bell if field is MEMO, otherwise, fill the field.
  341.     if type(cFld) = "M"
  342.         ?? chr(7)
  343.     else
  344.         *-- due to difference in function of HOME in the BROWSE mode,
  345.         *-- Ctrl-Home has to be used in BROWSE.
  346.         if upper(cScrType) = "BROWSE"
  347.             keyboard chr(29)+chr(25)+ClipBoard   && go to beginning of field,
  348.                                                  && and clear, putting contents
  349.                                                  && of clipboard in.
  350.         else
  351.             keyboard chr(26)+chr(25)+ClipBoard
  352.         endif
  353.     endif  && type ...
  354.  
  355. RETURN
  356. *-- EoP: Paste
  357.  
  358. FUNCTION Blanker
  359. *-------------------------------------------------------------------------------
  360. *-- Programmer..: Curt Schroeders (Borland Tech Support)
  361. *-- Date........: 07/01/1992
  362. *-- Notes.......: Used to BLANK a numeric field once the user presses a key
  363. *--               that may be used IN a numeric field. 
  364. *--               SIDE EFFECT -- if you use this function, the original value
  365. *--               in the field will be erased ... this does not allow editing
  366. *--               of the numeric field.
  367. *-- Written for.: dBASE IV, 1.5 (should work in 1.1)
  368. *-- Rev. History: 07/13/1992 -- Ken Mayer -- added '-' and '.' as valid
  369. *--               characters in list ...
  370. *-- Usage.......: Blanker()
  371. *-- Example.....: @5,10 get Salary when blanker()
  372. *-- Returns.....: Logical
  373. *-- Parameters..: None
  374. *-------------------------------------------------------------------------------
  375.     
  376.     private nX
  377.     
  378.     *-- get keystroke from user
  379.     nX = inkey(0)
  380.     
  381.     *-- if nX is in list
  382.     if chr(nX) $ "0123456789-."
  383.         keyboard "{CTRL-Y}"  && blank out field
  384.     endif
  385.     keyboard chr(nX)        && return this character ...
  386.  
  387. RETURN .t.
  388. *-- EoF: Blanker()
  389.  
  390. FUNCTION GetRange
  391. *-------------------------------------------------------------------------------
  392. *-- Programmer..: Joey D. Carroll  (JOEY)
  393. *-- Date........: 10/12/1992
  394. *-- Notes.......: A function to get a range for use with 'set key to range x,y'
  395. *--               or 'set filter to'. Works with character, numeric, float,
  396. *--               and date types.
  397. *-- Written for.: dBASE IV, 1.5
  398. *-- Rev. History: 11/08/1992 Changed to protect active windows.
  399. *--               Added SHADOW  (JOEY)
  400. *--               11/09/1992 Added (optional) cStyle parameter  (JOEY)
  401. *-- Calls.......: CENTER, SHADOW
  402. *-- Called by...: Any
  403. *-- Usage.......: ?? GetRange(<cText>,<xPara1>,<xPara2>,<cPicture>, ;
  404. *--               <nStartRow>,<cColor>[,cStyle])
  405. *-- Example.....: * get a range for a date, dbf in use is ordered by TRANDATE
  406. *--               dDate1={}
  407. *--               dDate2={}
  408. *--               ?? GetRange("Enter date range for your report",dDate1,dDate2,;
  409. *--                  "",10,"w+/r,n/w,w+/gb")
  410. *--               * now use values determined by getrange()
  411. *--               set key to range dDate1,dDate2
  412. *--               go top
  413. *--               * if the dbf is not indexed on a date or if you just =have=
  414. *--               *  to use a filter e.g.--
  415. *--               * set filter to Transdate >= dDate1 .and. Transdate<=dDate2
  416. *--               report form <yourreport> to print
  417. *-- Returns.....: .t. if correct type parameters, otherwise .f.
  418. *-- Parameters..: cText     = Message to center in window.  May be nul "".
  419. *--               xPara1     = First elemement of the 'key'.
  420. *--                              The 'width' of the character 'get' is
  421. *--                              determined by len(xPara1).
  422. *--                              The 'width' of the date 'get' is determined
  423. *--                              by set("century").
  424. *--               xPara2     = Second element of the 'key'.
  425. *--               cPicture  = Used to determine 'width' and format of
  426. *--                              numeric or float 'get', and the format
  427. *--                              of the character 'get'.  May be nul "".
  428. *--                              Ignored if xPara1 is date type.
  429. *--               nStartRow = Row to place top of window.
  430. *--                              Message row (24) is protected.
  431. *--               cColor    = Colors to be used ("Normal/HiLite/Box")
  432. *--                              (may be nul "", in order to use the
  433. *--                              default colors of window/screen)
  434. *--               cStyle    = "H" = horizontal  "V" = verticle  (may be
  435. *--                              omitted or ""/nul to default to "H" --
  436. *--                              =Very= long parameters default to "V")
  437. *-------------------------------------------------------------------------------
  438.  
  439.    parameters cText,xPara1,xPara2,cPicture,nStartRow,cColor,cStyle
  440.    private cTalk,cColor2,nSayLen,nPictLen,wPrevWind,nEndRow
  441.  
  442.    *-- is a window active
  443.    wPrevWind = window()
  444.    activate screen
  445.  
  446.    *-- in case no color is passed, this will prevent bomb
  447.    cColor2 = iif(isblank(cColor),"","color &cColor")
  448.  
  449.    *-- calculate window size based on parameters
  450.    do case
  451.       case type("xPara1") = "C"
  452.          *-- xPara1,xPara2 should initialized with space(len(alias->fieldname))
  453.          *--  or space(len(var))
  454.          nPictLen = 2 * len(xPara1)
  455.       case type("xPara1") = "N" .or. type("xPara1") = "F"
  456.          *-- gotta have a picture to define window width
  457.          cPicture = iif(isblank(cPicture),"9999999999",cPicture)
  458.          nPictLen  = 2 * len(cPicture)
  459.       case type("xPara1")="D"
  460.          nPictLen = 2 * (iif(set("CENTURY")="OFF",8,10))
  461.       otherwise
  462.          if .not. isblank(wPrevWind)
  463.             activate window &wPrevWind
  464.          endif
  465.          ?? chr(7)
  466.          RETURN .f.                  && stupid!
  467.    endcase
  468.  
  469.    cText = " "+cText       && don't jamb against box edge
  470.  
  471.    *-- is the window width going to be wider than 75 cols, OR was "V"
  472.    *--   passed in the cStyle param?  If so, use verticle style
  473.  
  474.    nSayLen = len("From: ") + len("To: ")
  475.    nWindWidth = nSayLen + nPictLen + 7
  476.    *-- if len(cText) > nWindWidth, fix it
  477.    nWindWidth = max(nWindWidth,len(cText) + 3)
  478.  
  479.    if nWindWidth <= 76 .and. (pcount() < 7 .or. upper(cStyle) = "H")
  480.       cStyle = "H"                        && make it so
  481.       nStartRow = min(nStartRow,16)       && protect row 24 even from shadow
  482.       nStartCol = (80-nWindWidth) / 2     && center the window
  483.       nEndRow = nStartRow + 6
  484.  
  485.       define window wGetRange from nStartRow,nStartCol to nEndRow, ;
  486.          nStartCol+nWindWidth &cColor2. double
  487.    else
  488.       *-- wants verticle style or params are too wide for horizontal
  489.       *--   so do some re-figgering
  490.       cStyle = "V"                        && make it so
  491.       nStartRow = min(nStartRow,14)       && protect row 24 even from shadow
  492.       nEndRow = nStartRow + 8
  493.       *-- recalc window width for this style
  494.       nSayLen    = len("From: ")
  495.       nPictLen   = nPictLen / 2           && doubled for horz., so cut by 1/2
  496.       nWindWidth = nSayLen + nPictLen + 7
  497.       *-- if len(cText) > nWindWidth, fix it
  498.       nWindWidth = max(nWindWidth,len(cText) + 3)
  499.       nStartCol  = (80-nWindWidth) / 2     && center the window
  500.  
  501.       define window wGetRange from nStartRow,nStartCol to nEndRow, ;
  502.          nStartCol+nWindWidth &cColor2. double
  503.    endif
  504.  
  505.    save screen to sGetRange
  506.  
  507.    *-- now USE what you've done so far
  508.    do shadow with nStartRow,nStartCol,nEndRow,nStartCol+nWindWidth
  509.    activate window wGetRange
  510.    do center with 1,nWindWidth - 2,"",cText
  511.  
  512.    @ 2,0 to 2,nWindWidth - 2
  513.    @ 3,2 say 'From:' get xPara1 picture cPicture
  514.  
  515.    if cStyle = "H"
  516.       @ 3,(nWindWidth- 2 ) - (len("To: ")) - (nPictLen/2) - 1 ;
  517.                   say 'To:' get xPara2 picture cPicture
  518.    else
  519.       @ 5,4 say 'To:' get xPara2 picture cPicture
  520.    endif
  521.  
  522.    read
  523.  
  524.    *-- clean up your doin's
  525.    deactivate window wGetRange
  526.    restore screen from sGetRange
  527.    release screen sGetRange
  528.    release window wGetRange
  529.  
  530.    if .not. isblank(wPrevWind)
  531.       activate window &wPrevWind
  532.    endif
  533.  
  534. RETURN .t.
  535. *-- EoF: GetRange()
  536.  
  537. FUNCTION FldWidth
  538. *-------------------------------------------------------------------------------
  539. *-- Programmer..: Kenneth Chan [HazMatZak] (CIS: 71542,2712)
  540. *-- Date........: 01/28/1993
  541. *-- Notes.......: Returns the width of a field, without having to read the
  542. *--               .DBF structure into a file and use low-level functions ...
  543. *-- Written for.: dBASE IV, 1.5
  544. *-- Rev. History: None
  545. *-- Calls.......: None
  546. *-- Called by...: Any
  547. *-- Usage.......: FldWidth(<nField>)
  548. *-- Example.....: ?FldWidth(3)
  549. *-- Returns.....: Numeric value
  550. *-- Parameters..: nField = field number in file structure
  551. *-------------------------------------------------------------------------------
  552.  
  553.     parameters nField
  554.     private nReturn, cFldType, cFldName
  555.     
  556.     cFldName = field(nField)   && get the field name
  557.     cFldType = type(cFldName)  && get the type ...
  558.     do case
  559.         case cFldType = "L"
  560.             nReturn = 1
  561.         case cFldType = "D"
  562.             nReturn = 8
  563.         case cFldType = "C"
  564.             nReturn = len(&cFldName.)
  565.         case cFldType $ "NF"
  566.             nReturn = len(transform(&cFldName.,"@L"))
  567.         otherwise
  568.             nReturn = 0
  569.     endcase
  570.     
  571. RETURN nReturn
  572. *-- EoF: FldWidth()
  573.  
  574. FUNCTION FldDec
  575. *-------------------------------------------------------------------------------
  576. *-- Programmer..: Kenneth Chan [HazMatZak] (CIS: 71542,2712)
  577. *-- Date........: 01/28/1993
  578. *-- Notes.......: Returns the number of decimal places of a numeric field. 
  579. *-- Written for.: dBASE IV, 1.5
  580. *-- Rev. History: None
  581. *-- Calls.......: None
  582. *-- Called by...: Any
  583. *-- Usage.......: FldDec(<nField>)
  584. *-- Example.....: ?FldDec(3)
  585. *-- Returns.....: Numeric value, 0 if non-numeric field type
  586. *-- Parameters..: nField = field number in file structure
  587. *-------------------------------------------------------------------------------
  588.  
  589.     parameters nField
  590.     private nReturn, cTemplate, cFldName
  591.     
  592.     cFldName = field(nField)
  593.     if type(cFldName) $ "NF"    && if it's numeric/float type
  594.         cTemplate = transform(&cFldName.,"@L")
  595.         nReturn = at(".",cTemplate)
  596.         if nReturn > 0
  597.             nReturn = len(cTemplate) - nReturn
  598.         endif
  599.     else
  600.         nReturn = 0
  601.     endif
  602.  
  603. RETURN nReturn
  604. *-- EoF: FldDec()
  605.  
  606. *-------------------------------------------------------------------------------
  607. *-- EoP: FIELDS.PRG
  608. *-------------------------------------------------------------------------------
  609.